Chapter 14
Code example 14-1
Public Sub ChangeStartupProps()
Dim dbs As Object
Set dbs = CurrentDB
'The following displays a custom menu bar at startup,
'turns off the full menus and forbids toolbar changes.
dbs.Properties("StartupMenuBar") = "DFG Custom"
dbs.Properties("AllowFullMenus") = False
dbs.Properties("AllowToolbarChanges") = False
End Sub
Code example 14-2
Public Sub StartUpProps()
'Declare property value constants.
Const strt_Text As Long = 10      'For text values
Const strt_Boolean As Long = 1    'For True/False values

ChangeProp "AppTitle", strt_Text, "Fish and Game"
ChangeProp "StartupForm", strt_Text, "Welcome"
ChangeProp "StartupMenuBar", strt_Text, "DFG Custom"
ChangeProp "StartupShowDBWindow", strt_Boolean, False
ChangeProp "StartupShowStatusBar", strt_Boolean, False
ChangeProp "AllowBuiltInToolbars", strt_Boolean, False
ChangeProp "AllowFullMenus", strt_Boolean, False
ChangeProp "AllowBreakIntoCode", strt_Boolean, False
ChangeProp "AllowSpecialKeys", strt_Boolean, False
ChangeProp "AllowToolbarChanges", strt_Boolean, False
'Change the title bar text immediately.
Application.RefreshTitleBar
End Sub
Code example 14-3
Public Function ChangeProp(strPropName As String, _
    varPropType As Variant, varPropValue As Variant)
Dim dbs As Object
Dim prp As Variant
Const conPropNotFoundError = 3270
Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProp = True

Change_Exit:
    Exit Function
    
Change_Err:
   If Err = conPropNotFoundError Then  'property not found
	 Debug.Print strPropName, Err.Number, Err.Description
        Set prp = dbs.CreateProperty(strPropName, _
            varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
    Else
        'Unknown error
        ChangeProp = False
        Resume Change_Exit
    End If
End Function
Code example 14-4
Public Sub ResetProps()
Dim dbsDFG As Database

Set dbsDFG = CurrentDb
With dbsDFG
    .Properties.Delete "AppTitle"
    .Properties.Delete "StartupForm"
    .Properties.Delete "StartupMenuBar"
    .Properties.Delete "AllowFullMenus"
    .Properties.Delete "AllowBuiltInToolbars"
    .Properties.Delete "StartupShowDBWindow"
    .Properties.Delete "StartupShowStatusBar"
    .Properties.Delete "AllowToolbarChanges"
End With
Application.RefreshTitleBar
End Sub
Code example 14-5
Public Sub ChangeOptions()
With Application
    .SetOption "Show Table Names", False
    .SetOption "Default Database Directory", "C:\My Documents\Wiley"
    .SetOption "Default Column Width", 2
    .SetOption "Default Number Field Size", 5
    .SetOption "Default Cell Effect", 2
End With
End Sub
Code example 14-6
Public Sub ReturnOptions()
Dim varSet1 As Variant, varSet2 As Variant
Dim varSet3 As Variant, varSet4 As Variant
Dim varSet5 As Variant

'Save current settings as variant variables
varSet1 = Application.GetOption("Show Table Names")
varSet2 = Application.GetOption("Default Database Directory")
varSet3 = Application.GetOption("Default Column Width")
varSet4 = Application.GetOption("Default Number Field Size")
varSet5 = Application.GetOption("Default Cell Effect")
Debug.Print "Show Table Names "; varSet1
Debug.Print "Default directory "; varSet2
Debug.Print "Default column width "; varSet3
Debug.Print "Default number field size "; varSet4
Debug.Print "Default datasheet cell effect "; varSet5
      
End Sub
Code example 14-7
'First declare the public variables
Public varGridH As Variant, varGridV As Variant
Public varFontName As Variant, varFontSize As Variant
Public varEProcs As Variant, varSpell1 As Variant
Public varSpell2 As Variant

Public Sub SaveOptions()

'Save the current settings as the public variables.
varGridH = Application.GetOption("Default Gridlines Horizontal")
varGridV = Application.GetOption("Default Gridlines Vertical")
varFontName = Application.GetOption("Default Font Name")
varFontSize = Application.GetOption("Default Font Size")
varEProcs = Application.GetOption("Always Use Event Procedures")
varSpell1 = Application.GetOption("Spelling Ignore words in UPPERCASE")
varSpell2 = Application.GetOption("Spelling Ignore words with number)
End Sub
Code example 14-8
Public Sub RestoreOpts()
'Set the options to the values saved
'in the public variables
With Application
    .SetOption "Default Gridlines Horizontal", varGridH
    .SetOption "Default Gridlines Vertical", varGridV
    .SetOption "Default Font Name", varFontName
    .SetOption "Default Font Size", varFontSize
    .SetOption "Always Use Event Procedures", varEProcs
    .SetOption "Spelling Ignore Words in UPPERCASE", varSpell1
    .SetOption "Spelling Ignore Words with number", varSpell2
End With
End Sub
Code example 14-9
Public Sub CreateProp()
Dim dbsDFG As Database
Dim prpNew As Property
Dim prpColl As Property

Set dbsDFG = CurrentDb
'Create and append new property
With dbsDFG
Set prpNew = .CreateProperty("MyProp", dbText, "Here it is!")
   .Properties.Append prpNew
End With
End Sub
Code example 14-10
Public Function HideWelcomeForm()
On Error GoTo HideWelcomeForm_Err

'Tests the HideWelcomeForm check box to determine if it was
'checked. If True, changes the database's Startup Form property.
'Attach it to the On Close event property of the Welcome form.

If Forms!Welcome!HideWelcomeForm Then
    'The check box is checked, so change the StartupForm
    'property to Switchboard. If not, leave as Welcome.
    CurrentDb().Properties("StartupForm") = "Switchboard"
Else
    CurrentDb().Properties("StartupForm") = "Welcome"
End If

Exit Function

HideWelcomeForm_Err:
    'If the property is not found in the collection, 
    'create it and set it to the Switchboard form.
    'Then append the property to the collection.
    Const conPropertyNotFound = 3270
    If Err = conPropertyNotFound Then
        Dim dbs As Database
        Dim prop As Property
        Set dbs = CurrentDb()
        Set prop = dbs.CreateProperty("StartupForm", dbText, _       "Switchboard")
        dbs.Properties.Append prop
        Resume Next
    End If
End Function

Access Power Programming with VBA, 8/23/2003, Web code examples
Virginia Andersen


